Doing Data Science Case Study 2

Heat Map Charts

Because of the data that we were able to analyze as part of the Par Plots above, we developed 2 Heat Maps and Correlations and Distribution Matrix to take a deeper dive in the data set.

# Heat Map for All Fields
employeeHeatMap <- round(cor(emp_result[,c(cols.NumericAll)]),2)

## Warning in cor(emp_result[, c(cols.NumericAll)]): the standard deviation is
## zero

melted_employeeHeatMap <- melt(employeeHeatMap)
ggplot(data = melted_employeeHeatMap, aes(x=X1, y=X2, fill=value)) + 
  theme(axis.text.x  = element_blank(),axis.ticks.x=element_blank(),axis.title.x=element_blank(),axis.text.y  = element_text(size = 7))+geom_tile()

#ggsave("images/employeeHeatMap.png",plot = last_plot(), type = png())
# Heat Map for Key Sign Fields
employeeHeatMapSig <- round(cor(emp_result[,c(cols.KeyFieldsBaseModel)]),2)
melted_employeeHeatMapSig <- melt(employeeHeatMapSig)
ggplot(data = melted_employeeHeatMapSig, aes(x=X1, y=X2, fill=value)) + 
  theme(axis.text.x  = element_blank(),axis.ticks.x=element_blank(),axis.title.x=element_blank(),axis.text.y  = element_text(size = 7))+
  geom_tile()

#ggsave("images/employeeHeatMapSig.png",plot = last_plot(), type = png())
# EDA For Key Sign Fields on Attrition for Overall Model
ggkeySignPairs <- ggpairs(
  mapping = ggplot2::aes(color = emp_result$Attrition),
  emp_result[,c(cols.KeyFieldsBaseModel)], 
  diag=list(continuous="densityDiag", discrete="barDiag"), 
  axisLabels="show") + theme_minimal()
#ggsave("ggkeySignPairs.png",plot = last_plot(), type = png())

Signficant Key Factor attributing to Attirtion

Showing the significance, p-values, for each variable. This is the base information to understand the key contributors that affect attrition. This data will be used through our data science work so we can utilize the following variables for the models we build.

The following table outlines the top significant factors contributing to attrition:

#TrainDataSet
glm_modeltrain <- glm(emp_train$Attrition~.,emp_train[,c(cols.CatGLM)], family = binomial) # glm train
model_Train = data.frame(coef(summary(glm_modeltrain))[,4]) # pvalue from glm train
names(model_Train) = "Logistic Regressio on Training Set" # title 
#TestDataSet
glm_modeltest <- glm(emp_test$Attrition~.,emp_test[,c(cols.CatGLM)], family = binomial) # glm test

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

model_Test = data.frame(coef(summary(glm_modeltest))[,4]) # pvalue from glm test
names(model_Test) = "Logistic Regression Test on Test" # title
#AllData
glm_modelAll <- glm(emp_result$Attrition~.,emp_result[,c(cols.CatGLM)], family = binomial) # glm for all combined test and train data set

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

model_All = data.frame(coef(summary(glm_modelAll))[,4]) # pvalue fro combined data set
names(model_All) = "Logistic Regressio on All Data" # title
# Table consolidated
GLM_dataset <-cbind(model_Train, model_Test,model_All) # consolidated train, test and all data set
# Creating kable table for GLM dataset
GLM_dataset  %>%  kable() %>% kable_styling(bootstrap_options = "striped", full_width = F) %>% scroll_box(width = "600px", height = "450px")

Basic Regrewssion for each Job Role

Learning about any job role specific trends that may exist in the data set is key because it tells us which variables are significant by job. This data can be used to identify what affects will contribute to attrition rate by job. Any value that is < 0.5 is significant

From the tables below, each job description will show the key attributes for attrition:

# Glm for Job role - Human Resources
glm_model_JobRoleHR <- glm(emp_result$`JobRole_Human Resources`~.,emp_result[,c(col.NoJobRole)], family = binomial) # glm

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

JobRoleHR = data.frame(coef(summary(glm_model_JobRoleHR))[,4]) # pulling only pvalue from the glm
names(JobRoleHR) = "Human Resources" # creating title
# Glm for Job role - Manufactoring Director
glm_model_JobRoleManufactoring <- glm(emp_result$`JobRole_Manufacturing Director`~.,emp_result[,c(col.NoJobRole)], family = binomial)# glm
JobRoleManufactoring = data.frame(coef(summary(glm_model_JobRoleManufactoring))[,4])# pulling only pvalue from the glm
names(JobRoleManufactoring) = "Manufacturing Director" # creating title
# Glm for Job role - Research Scientist
glm_model_JobRoleResearch <- glm(emp_result$`JobRole_Research Scientist`~.,emp_result[,c(col.NoJobRole)], family = binomial)# glm
JobRoleResearch = data.frame(coef(summary(glm_model_JobRoleResearch))[,4])# pulling only pvalue from the glm
names(JobRoleResearch) = "Research Scientist" # creating title
# Glm for Job role - Lab Tech
glm_model_JobRoleLab <- glm(emp_result$`JobRole_Laboratory Technician`~.,emp_result[,c(col.NoJobRole)], family = binomial)# glm
JobRoleLab = data.frame(coef(summary(glm_model_JobRoleLab))[,4])# pulling only pvalue from the glm
names(JobRoleLab) = "Laboratory Technician" # creating title
# Glm for Job role - Research Director
glm_model_JobRoleResearchDirector <- glm(emp_result$`JobRole_Research Director`~.,emp_result[,c(col.NoJobRole)], family = binomial)# glm

## Warning: glm.fit: algorithm did not converge

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

JobRoleRD = data.frame(coef(summary(glm_model_JobRoleResearchDirector))[,4])# pulling only pvalue from the glm
names(JobRoleRD) = "Research Director" # creating title
# Glm for Job role - Sales Exec
glm_model_JobRoleSalesExec <- glm(emp_result$`JobRole_Sales Executive`~.,emp_result[,c(col.NoJobRole)], family = binomial)# glm
JobRoleSE = data.frame(coef(summary(glm_model_JobRoleSalesExec))[,4])# pulling only pvalue from the glm
names(JobRoleSE) = "Sales Executive" # creating title
# Glm for Job role - Sales Person
glm_model_JobRoleSalesPerson <- glm(emp_result$`JobRole_Sales Representative`~.,emp_result[,c(col.NoJobRole)], family = binomial)# glm

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

JobRoleSP = data.frame(coef(summary(glm_model_JobRoleSalesPerson))[,4])# pulling only pvalue from the glm
names(JobRoleSP) = "Sales Representative" # creating title
# Glm for Job role - Manager
glm_model_JobRoleManager <- glm(emp_result$JobRole_Manager~.,emp_result[,c(col.NoJobRole)], family = binomial)# glm

## Warning: glm.fit: algorithm did not converge

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

JobRoleManager = data.frame(coef(summary(glm_model_JobRoleManager))[,4])# pulling only pvalue from the glm
names(JobRoleManager) = "Manager" # creating title
# Glm for Job role - HealthCare
glm_model_JobRoleHealth <- glm(emp_result$`JobRole_Healthcare Representative`~.,emp_result[,c(col.NoJobRole)], family = binomial)# glm
JobRoleHealthR = data.frame(coef(summary(glm_model_JobRoleHealth))[,4])# pulling only pvalue from the glm
names(JobRoleHealthR) = "Healthcare Representative" # creating title
# Gener by Job Role
glm_model_Gender  <- glm(emp_train$Gender~.,emp_train[,c(cols.JobRoles)], family = binomial)# glm
Gender_Model = data.frame(coef(summary(glm_model_Gender))[,4])# pulling only pvalue from the glm
names(Gender_Model) = "Gender" # creating title
# Marital Status by Role
glm_model_Marital  <- glm(emp_train$MaritalStatus~.,emp_train[,c(cols.JobRoles)], family = binomial)# glm
Marital_Model = data.frame(coef(summary(glm_model_Marital))[,4])# pulling only pvalue from the glm
names(Marital_Model) = "Marital Status" # creating title
# Consolidated all the job role glm
Table.glm <-cbind(JobRoleHR, JobRoleManufactoring,JobRoleResearch,JobRoleLab,JobRoleRD,JobRoleSE,JobRoleManager)
# kable output for the consolidated glm
Table.glm  %>%  kable() %>% kable_styling(bootstrap_options = "striped", full_width = F) %>% scroll_box(width = "800px", height = "450px")

# kable output for the Gender by Job Role glm
Gender_Model  %>%  kable() %>% kable_styling(bootstrap_options = "striped", full_width = F) %>% scroll_box(width = "500px", height = "450px")

# kable output for the Martial Status Role glm
Marital_Model  %>%  kable() %>% kable_styling(bootstrap_options = "striped", full_width = F) %>% scroll_box(width = "500px", height = "450px")

KNN Model

Running the full KNN model using the training and test data set. The full KNN model came out to have a high accuracy rate of 84%, from there we decided to run the KNN model by job role. The glm showed us that each job has different variables of significance, so the KNN by job reflects different variables that pertains to that specific role.

As a key note, KNN works better with larger data sets than splitting them into job positions.

# KNN
set.seed(123)
#knn.train = train(Attrition~., data=emp_train[,c(cols.CatKNN)], method="knn", trControl=control, tuneGrid=grid1)
knn.train = train(Attrition~., data=emp_train[,c(cols.CatKNN)], method="knn")
knn.train

## k-Nearest Neighbors 
## 
## 1170 samples
##   56 predictor
##    2 classes: 'No', 'Yes' 
## 
## No pre-processing
## Resampling: Bootstrapped (25 reps) 
## Summary of sample sizes: 1170, 1170, 1170, 1170, 1170, 1170, ... 
## Resampling results across tuning parameters:
## 
##   k  Accuracy   Kappa      
##   5  0.7782905  0.008056618
##   7  0.7956919  0.005752565
##   9  0.8099105  0.010861496
## 
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 9.

#Set K=18 sq of 1480
knn.test = knn(emp_train[,c(cols.CatKNN)][,-3], emp_test[,c(cols.CatKNN)][,-3], emp_train[,c(cols.CatKNN)][,3], k=18)
knnPrediction <-confusionMatrix(table(knn.test, emp_test$Attrition))
knnPrediction

## Confusion Matrix and Statistics
## 
##         
## knn.test  No Yes
##      No  251  48
##      Yes   0   1
##                                           
##                Accuracy : 0.84            
##                  95% CI : (0.7935, 0.8796)
##     No Information Rate : 0.8367          
##     P-Value [Acc > NIR] : 0.4758          
##                                           
##                   Kappa : 0.0337          
##  Mcnemar's Test P-Value : 1.17e-11        
##                                           
##             Sensitivity : 1.00000         
##             Specificity : 0.02041         
##          Pos Pred Value : 0.83946         
##          Neg Pred Value : 1.00000         
##              Prevalence : 0.83667         
##          Detection Rate : 0.83667         
##    Detection Prevalence : 0.99667         
##       Balanced Accuracy : 0.51020         
##                                           
##        'Positive' Class : No              
## 

fourfoldplot(knnPrediction$table)

KNN Weighted

Running the Weighted KNN model using the training and test data set. The Weighted KNN model came out to have a higher accuracy rate of 84.4 than the KNN which was 84%. Additional, the plot below shows the optimal K which is 30.

# K Weighted
set.seed(123)
#performs leave-one-out crossvalidation 
kknn.train = train.kknn(Attrition~., data=emp_train[,c(cols.CatKNN)], kmax=30, distance = 2)
#Predict Attribution
prediction <- predict(kknn.train, emp_test[,c(cols.CatKNN)][,-3])
#Show Confusion Matrix
kWeightedPrediction <- confusionMatrix(table(prediction, emp_test[,c(cols.CatKNN)][,3]))
kWeightedPrediction

## Confusion Matrix and Statistics
## 
##           
## prediction  No Yes
##        No  251  47
##        Yes   0   2
##                                           
##                Accuracy : 0.8433          
##                  95% CI : (0.7972, 0.8826)
##     No Information Rate : 0.8367          
##     P-Value [Acc > NIR] : 0.4139          
##                                           
##                   Kappa : 0.0665          
##  Mcnemar's Test P-Value : 1.949e-11       
##                                           
##             Sensitivity : 1.00000         
##             Specificity : 0.04082         
##          Pos Pred Value : 0.84228         
##          Neg Pred Value : 1.00000         
##              Prevalence : 0.83667         
##          Detection Rate : 0.83667         
##    Detection Prevalence : 0.99333         
##       Balanced Accuracy : 0.52041         
##                                           
##        'Positive' Class : No              
## 

fourfoldplot(kWeightedPrediction$table)

# Plot Prediction for number of K
graphics.off() 
par(mar=c(5,5,5,5))
plot(kknn.train)

Logistic_Regression

The following model is logistic regression the test and training set for all the fields. For logistic regression to work, the data was formatted to numeric data and setup with a prediction interval in which we converted a probability. In this model, we predicted at an 87% rate.

# Logistic Regression (No Lasso) - Winning Model
#Base Model
glm_model <- glm(emp_train$Attrition~.,data = emp_train[,c(cols.CatGLM)], family = binomial)
summary(glm_model)

## 
## Call:
## glm(formula = emp_train$Attrition ~ ., family = binomial, data = emp_train[, 
##     c(cols.CatGLM)])
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.5831  -0.4893  -0.2395  -0.0824   3.2351  
## 
## Coefficients: (3 not defined because of singularities)
##                                    Estimate Std. Error z value Pr(>|z|)
## (Intercept)                      -1.254e+01  6.957e+02  -0.018 0.985624
## ID                                9.763e-05  2.958e-04   0.330 0.741323
## Age                              -1.917e-02  1.523e-02  -1.259 0.208184
## BusinessTravelTravel_Frequently   1.858e+00  4.663e-01   3.985 6.74e-05
## BusinessTravelTravel_Rarely       9.574e-01  4.292e-01   2.231 0.025704
## DailyRate                        -3.949e-04  2.497e-04  -1.581 0.113774
## DepartmentResearch & Development  1.388e+01  6.957e+02   0.020 0.984083
## DepartmentSales                   1.256e+01  6.957e+02   0.018 0.985594
## DistanceFromHome                  4.361e-02  1.213e-02   3.595 0.000324
## Education                         2.211e-02  1.009e-01   0.219 0.826621
## EducationFieldLife Sciences      -3.611e-02  1.154e+00  -0.031 0.975033
## EducationFieldMarketing           2.371e-01  1.203e+00   0.197 0.843799
## EducationFieldMedical            -1.310e-01  1.157e+00  -0.113 0.909880
## EducationFieldOther              -4.750e-01  1.216e+00  -0.391 0.696003
## EducationFieldTechnical Degree    8.451e-01  1.165e+00   0.725 0.468361
## EmployeeCount                            NA         NA      NA       NA
## EmployeeNumber                   -2.082e-05  1.704e-04  -0.122 0.902721
## EnvironmentSatisfaction          -4.711e-01  9.506e-02  -4.956 7.19e-07
## GenderMale                        3.846e-01  2.092e-01   1.838 0.066038
## HourlyRate                        6.008e-03  5.046e-03   1.191 0.233741
## JobInvolvement                   -6.303e-01  1.392e-01  -4.526 6.00e-06
## JobLevel                         -3.281e-01  3.454e-01  -0.950 0.342197
## JobRoleHuman Resources            1.484e+01  6.957e+02   0.021 0.982979
## JobRoleLaboratory Technician      1.284e+00  5.151e-01   2.492 0.012707
## JobRoleManager                    1.561e-01  9.205e-01   0.170 0.865340
## JobRoleManufacturing Director    -7.803e-02  5.739e-01  -0.136 0.891857
## JobRoleResearch Director         -2.824e+00  1.339e+00  -2.109 0.034961
## JobRoleResearch Scientist         9.597e-02  5.307e-01   0.181 0.856513
## JobRoleSales Executive            2.046e+00  1.376e+00   1.486 0.137207
## JobRoleSales Representative       3.097e+00  1.427e+00   2.170 0.029993
## JobSatisfaction                  -3.917e-01  9.164e-02  -4.274 1.92e-05
## MaritalStatusMarried              5.912e-01  3.146e-01   1.879 0.060186
## MaritalStatusSingle               1.334e+00  3.984e-01   3.348 0.000814
## MonthlyIncome                     1.129e-04  8.975e-05   1.258 0.208543
## MonthlyRate                      -1.078e-05  1.423e-05  -0.758 0.448472
## NumCompaniesWorked                2.006e-01  4.399e-02   4.560 5.12e-06
## Over18_Y                                 NA         NA      NA       NA
## OverTimeYes                       1.959e+00  2.216e-01   8.841  < 2e-16
## PercentSalaryHike                -1.991e-02  4.505e-02  -0.442 0.658572
## PerformanceRating                 1.509e-01  4.586e-01   0.329 0.742089
## RelationshipSatisfaction         -1.950e-01  9.319e-02  -2.093 0.036380
## StandardHours                            NA         NA      NA       NA
## StockOptionLevel                 -1.985e-01  1.740e-01  -1.141 0.254050
## TotalWorkingYears                -8.257e-02  3.364e-02  -2.455 0.014102
## TrainingTimesLastYear            -1.768e-01  8.321e-02  -2.125 0.033591
## WorkLifeBalance                  -4.776e-01  1.400e-01  -3.411 0.000648
## YearsAtCompany                    1.105e-01  4.333e-02   2.549 0.010793
## YearsInCurrentRole               -1.479e-01  5.056e-02  -2.926 0.003432
## YearsSinceLastPromotion           1.862e-01  4.763e-02   3.909 9.25e-05
## YearsWithCurrManager             -1.237e-01  4.987e-02  -2.481 0.013111
##                                     
## (Intercept)                         
## ID                                  
## Age                                 
## BusinessTravelTravel_Frequently  ***
## BusinessTravelTravel_Rarely      *  
## DailyRate                           
## DepartmentResearch & Development    
## DepartmentSales                     
## DistanceFromHome                 ***
## Education                           
## EducationFieldLife Sciences         
## EducationFieldMarketing             
## EducationFieldMedical               
## EducationFieldOther                 
## EducationFieldTechnical Degree      
## EmployeeCount                       
## EmployeeNumber                      
## EnvironmentSatisfaction          ***
## GenderMale                       .  
## HourlyRate                          
## JobInvolvement                   ***
## JobLevel                            
## JobRoleHuman Resources              
## JobRoleLaboratory Technician     *  
## JobRoleManager                      
## JobRoleManufacturing Director       
## JobRoleResearch Director         *  
## JobRoleResearch Scientist           
## JobRoleSales Executive              
## JobRoleSales Representative      *  
## JobSatisfaction                  ***
## MaritalStatusMarried             .  
## MaritalStatusSingle              ***
## MonthlyIncome                       
## MonthlyRate                         
## NumCompaniesWorked               ***
## Over18_Y                            
## OverTimeYes                      ***
## PercentSalaryHike                   
## PerformanceRating                   
## RelationshipSatisfaction         *  
## StandardHours                       
## StockOptionLevel                    
## TotalWorkingYears                *  
## TrainingTimesLastYear            *  
## WorkLifeBalance                  ***
## YearsAtCompany                   *  
## YearsInCurrentRole               ** 
## YearsSinceLastPromotion          ***
## YearsWithCurrManager             *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1031.48  on 1169  degrees of freedom
## Residual deviance:  674.24  on 1123  degrees of freedom
## AIC: 768.24
## 
## Number of Fisher Scoring iterations: 15

#predict probabilities on testset
#type="response" gives probabilities, type="class" gives class
glm_prob <- predict.glm(glm_model,emp_test[,-3],type="response")

## Warning in predict.lm(object, newdata, se.fit, scale = 1, type =
## ifelse(type == : prediction from a rank-deficient fit may be misleading

#which classes do these probabilities refer to? What are 1 and 0?
contrasts(emp_test$Attrition)

##     Yes
## No    0
## Yes   1

#make predictions
##.first create vector to hold predictions (we know 0 refers to neg now)
dfTrain <- rep("No",nrow(emp_test))
dfTrain[glm_prob>.5] <- "Yes"
#confusion matrix
LogRegOnly <-confusionMatrix(table(pred=dfTrain,true=emp_test$Attrition))
LogRegOnly

## Confusion Matrix and Statistics
## 
##      true
## pred   No Yes
##   No  244  32
##   Yes   7  17
##                                           
##                Accuracy : 0.87            
##                  95% CI : (0.8266, 0.9059)
##     No Information Rate : 0.8367          
##     P-Value [Acc > NIR] : 0.0658297       
##                                           
##                   Kappa : 0.4015          
##  Mcnemar's Test P-Value : 0.0001215       
##                                           
##             Sensitivity : 0.9721          
##             Specificity : 0.3469          
##          Pos Pred Value : 0.8841          
##          Neg Pred Value : 0.7083          
##              Prevalence : 0.8367          
##          Detection Rate : 0.8133          
##    Detection Prevalence : 0.9200          
##       Balanced Accuracy : 0.6595          
##                                           
##        'Positive' Class : No              
## 

fourfoldplot(LogRegOnly$table)

dfPreds = data.frame(emp_test$ID,dfTrain)
colnames(dfPreds) = c("ID","Prediction")
dfPreds

##       ID Prediction
## 1   1171         No
## 2   1172         No
## 3   1173         No
## 4   1174         No
## 5   1175         No
## 6   1176         No
## 7   1177         No
## 8   1178         No
## 9   1179         No
## 10  1180         No
## 11  1181         No
## 12  1182         No
## 13  1183         No
## 14  1184         No
## 15  1185         No
## 16  1186         No
## 17  1187         No
## 18  1188         No
## 19  1189        Yes
## 20  1190         No
## 21  1191         No
## 22  1192         No
## 23  1193         No
## 24  1194         No
## 25  1195         No
## 26  1196        Yes
## 27  1197         No
## 28  1198         No
## 29  1199        Yes
## 30  1200         No
## 31  1201         No
## 32  1202        Yes
## 33  1203         No
## 34  1204         No
## 35  1205         No
## 36  1206         No
## 37  1207         No
## 38  1208         No
## 39  1209         No
## 40  1210         No
## 41  1211         No
## 42  1212         No
## 43  1213         No
## 44  1214         No
## 45  1215         No
## 46  1216         No
## 47  1217        Yes
## 48  1218         No
## 49  1219         No
## 50  1220         No
## 51  1221         No
## 52  1222         No
## 53  1223         No
## 54  1224         No
## 55  1225         No
## 56  1226         No
## 57  1227         No
## 58  1228         No
## 59  1229         No
## 60  1230         No
## 61  1231         No
## 62  1232         No
## 63  1233         No
## 64  1234         No
## 65  1235         No
## 66  1236         No
## 67  1237         No
## 68  1238         No
## 69  1239         No
## 70  1240         No
## 71  1241         No
## 72  1242         No
## 73  1243         No
## 74  1244         No
## 75  1245         No
## 76  1246         No
## 77  1247         No
## 78  1248        Yes
## 79  1249         No
## 80  1250         No
## 81  1251         No
## 82  1252         No
## 83  1253        Yes
## 84  1254         No
## 85  1255         No
## 86  1256         No
## 87  1257         No
## 88  1258         No
## 89  1259         No
## 90  1260         No
## 91  1261         No
## 92  1262         No
## 93  1263         No
## 94  1264         No
## 95  1265         No
## 96  1266         No
## 97  1267         No
## 98  1268        Yes
## 99  1269         No
## 100 1270         No
## 101 1271         No
## 102 1272         No
## 103 1273         No
## 104 1274        Yes
## 105 1275         No
## 106 1276         No
## 107 1277         No
## 108 1278         No
## 109 1279         No
## 110 1280         No
## 111 1281         No
## 112 1282         No
## 113 1283         No
## 114 1284         No
## 115 1285         No
## 116 1286         No
## 117 1287         No
## 118 1288        Yes
## 119 1289         No
## 120 1290         No
## 121 1291         No
## 122 1292        Yes
## 123 1293         No
## 124 1294         No
## 125 1295         No
## 126 1296         No
## 127 1297         No
## 128 1298         No
## 129 1299         No
## 130 1300         No
## 131 1301         No
## 132 1302         No
## 133 1303         No
## 134 1304        Yes
## 135 1305         No
## 136 1306         No
## 137 1307         No
## 138 1308         No
## 139 1309         No
## 140 1310         No
## 141 1311         No
## 142 1312         No
## 143 1313         No
## 144 1314         No
## 145 1315         No
## 146 1316         No
## 147 1317         No
## 148 1318         No
## 149 1319         No
## 150 1320         No
## 151 1321         No
## 152 1322         No
## 153 1323         No
## 154 1324         No
## 155 1325         No
## 156 1326         No
## 157 1327         No
## 158 1328         No
## 159 1329         No
## 160 1330         No
## 161 1331         No
## 162 1332        Yes
## 163 1333         No
## 164 1334        Yes
## 165 1335         No
## 166 1336         No
## 167 1337         No
## 168 1338         No
## 169 1339         No
## 170 1340        Yes
## 171 1341         No
## 172 1342         No
## 173 1343         No
## 174 1344         No
## 175 1345         No
## 176 1346         No
## 177 1347         No
## 178 1348        Yes
## 179 1349        Yes
## 180 1350         No
## 181 1351         No
## 182 1352         No
## 183 1353         No
## 184 1354         No
## 185 1355         No
## 186 1356         No
## 187 1357         No
## 188 1358         No
## 189 1359         No
## 190 1360         No
## 191 1361        Yes
## 192 1362         No
## 193 1363         No
## 194 1364         No
## 195 1365        Yes
## 196 1366         No
## 197 1367         No
## 198 1368         No
## 199 1369         No
## 200 1370         No
## 201 1371         No
## 202 1372         No
## 203 1373         No
## 204 1374         No
## 205 1375         No
## 206 1376         No
## 207 1377         No
## 208 1378         No
## 209 1379         No
## 210 1380         No
## 211 1381         No
## 212 1382         No
## 213 1383         No
## 214 1384         No
## 215 1385         No
## 216 1386         No
## 217 1387         No
## 218 1388         No
## 219 1389         No
## 220 1390         No
## 221 1391         No
## 222 1392         No
## 223 1393         No
## 224 1394         No
## 225 1395         No
## 226 1396         No
## 227 1397         No
## 228 1398         No
## 229 1399         No
## 230 1400        Yes
## 231 1401         No
## 232 1402         No
## 233 1403         No
## 234 1404         No
## 235 1405         No
## 236 1406         No
## 237 1407         No
## 238 1408         No
## 239 1409         No
## 240 1410         No
## 241 1411        Yes
## 242 1412        Yes
## 243 1413         No
## 244 1414         No
## 245 1415         No
## 246 1416         No
## 247 1417         No
## 248 1418         No
## 249 1419         No
## 250 1420         No
## 251 1421         No
## 252 1422         No
## 253 1423         No
## 254 1424         No
## 255 1425         No
## 256 1426         No
## 257 1427         No
## 258 1428         No
## 259 1429         No
## 260 1430         No
## 261 1431         No
## 262 1432         No
## 263 1433         No
## 264 1434         No
## 265 1435         No
## 266 1436        Yes
## 267 1437         No
## 268 1438         No
## 269 1439         No
## 270 1440         No
## 271 1441         No
## 272 1442         No
## 273 1443         No
## 274 1444         No
## 275 1445         No
## 276 1446         No
## 277 1447         No
## 278 1448         No
## 279 1449         No
## 280 1450         No
## 281 1451         No
## 282 1452         No
## 283 1453         No
## 284 1454         No
## 285 1455         No
## 286 1456         No
## 287 1457         No
## 288 1458         No
## 289 1459         No
## 290 1460        Yes
## 291 1461         No
## 292 1462         No
## 293 1463         No
## 294 1464         No
## 295 1465         No
## 296 1466         No
## 297 1467         No
## 298 1468         No
## 299 1469         No
## 300 1470         No

write.csv(dfPreds,file = "LabelPrediction.csv",row.names = FALSE)

Summary Explanation:

The following table outlines the four different models that were used in accuracy order. As you can tell, logistic regression was the most accurate; however, we recommend using the logistic regression using lasso because it is more efficient.

# Prediciton Models
# Review Prediciton Models
LogRegOnly # Log Regression

## Confusion Matrix and Statistics
## 
##      true
## pred   No Yes
##   No  244  32
##   Yes   7  17
##                                           
##                Accuracy : 0.87            
##                  95% CI : (0.8266, 0.9059)
##     No Information Rate : 0.8367          
##     P-Value [Acc > NIR] : 0.0658297       
##                                           
##                   Kappa : 0.4015          
##  Mcnemar's Test P-Value : 0.0001215       
##                                           
##             Sensitivity : 0.9721          
##             Specificity : 0.3469          
##          Pos Pred Value : 0.8841          
##          Neg Pred Value : 0.7083          
##              Prevalence : 0.8367          
##          Detection Rate : 0.8133          
##    Detection Prevalence : 0.9200          
##       Balanced Accuracy : 0.6595          
##                                           
##        'Positive' Class : No              
## 

Lassofinal # LogRessions with Lasso

## Confusion Matrix and Statistics
## 
##      
##        No Yes
##   No  246  37
##   Yes   5  12
##                                           
##                Accuracy : 0.86            
##                  95% CI : (0.8155, 0.8972)
##     No Information Rate : 0.8367          
##     P-Value [Acc > NIR] : 0.1548          
##                                           
##                   Kappa : 0.3052          
##  Mcnemar's Test P-Value : 1.724e-06       
##                                           
##             Sensitivity : 0.9801          
##             Specificity : 0.2449          
##          Pos Pred Value : 0.8693          
##          Neg Pred Value : 0.7059          
##              Prevalence : 0.8367          
##          Detection Rate : 0.8200          
##    Detection Prevalence : 0.9433          
##       Balanced Accuracy : 0.6125          
##                                           
##        'Positive' Class : No              
## 

knnPrediction # kNN 

## Confusion Matrix and Statistics
## 
##         
## knn.test  No Yes
##      No  251  48
##      Yes   0   1
##                                           
##                Accuracy : 0.84            
##                  95% CI : (0.7935, 0.8796)
##     No Information Rate : 0.8367          
##     P-Value [Acc > NIR] : 0.4758          
##                                           
##                   Kappa : 0.0337          
##  Mcnemar's Test P-Value : 1.17e-11        
##                                           
##             Sensitivity : 1.00000         
##             Specificity : 0.02041         
##          Pos Pred Value : 0.83946         
##          Neg Pred Value : 1.00000         
##              Prevalence : 0.83667         
##          Detection Rate : 0.83667         
##    Detection Prevalence : 0.99667         
##       Balanced Accuracy : 0.51020         
##                                           
##        'Positive' Class : No              
## 

kWeightedPrediction # K Weighted

## Confusion Matrix and Statistics
## 
##           
## prediction  No Yes
##        No  251  47
##        Yes   0   2
##                                           
##                Accuracy : 0.8433          
##                  95% CI : (0.7972, 0.8826)
##     No Information Rate : 0.8367          
##     P-Value [Acc > NIR] : 0.4139          
##                                           
##                   Kappa : 0.0665          
##  Mcnemar's Test P-Value : 1.949e-11       
##                                           
##             Sensitivity : 1.00000         
##             Specificity : 0.04082         
##          Pos Pred Value : 0.84228         
##          Neg Pred Value : 1.00000         
##              Prevalence : 0.83667         
##          Detection Rate : 0.83667         
##    Detection Prevalence : 0.99333         
##       Balanced Accuracy : 0.52041         
##                                           
##        'Positive' Class : No              
## 

# Create Prediction Summary Table
dt0 <- data.frame(cbind(t(LogRegOnly$overall),t(LogRegOnly$byClass)))
dt0$Type <- as.character("LogRegOnly")
dt1 <- data.frame(cbind(t(knnPrediction$overall),t(knnPrediction$byClass)))
dt1$Type <- as.character("kNN")
dt3 <- data.frame(cbind(t(kWeightedPrediction$overall),t(kWeightedPrediction$byClass)))
dt3$Type <- as.character("kWeighted")
dt4 <- data.frame(cbind(t(Lassofinal$overall),t(Lassofinal$byClass)))
dt4$Type <- as.character("Lassofinal")
SummaryPred <-rbind(dt0, dt1, dt3, dt4)
SummaryPred <- SummaryPred[order(-SummaryPred$Accuracy),]
SummaryPred <- SummaryPred[,c(19,1:18)]
SummaryT <- SummaryPred[,c(1,2,9, 10)]
#SummaryPred  %>%  kable() %>% kable_styling(bootstrap_options = "striped", full_width = F) %>% scroll_box(width = "100%", height = "200px")
SummaryT  %>%  kable() %>% kable_styling(bootstrap_options = "striped", full_width = F) %>% scroll_box(width = "100%", height = "200px")

#dfTrain <- read.csv("E:/Documents/School/MSDS 6306/Case Study 2/CaseStudy2-data.csv", na.strings = "Null")
#dfVal <- read.csv("E:/Documents/School/MSDS 6306/Case Study 2/CaseStudy2Validation.csv", na.strings = "Null")
#Grant Path
#dfTrain <- read.csv("CaseStudy2-data.csv", na.strings = "NULL")
#dfVal <- read.csv("CaseStudy2Validation.csv", na.strings = "NULL")

#dfTrain2 <- fastDummies::dummy_cols(dfTrain) # Create Dummy Variables
#dfVal2 <- fastDummies::dummy_cols(dfVal) # Create Dummy

#Col.KNN <- c(2,5,7,8,10,11,12,14,15,16,18,20,21,22,25,26,27,28,29,30,31,32,33,34,35,36,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68)

# KNN
#set.seed(1)
#fit = train(Attrition~., data=dfTrain2[,c(cols.CatKNN)], method="knn")
#dfVal$Predictions = predict(fit,dfVal2)

#dfPreds = data.frame(dfVal$ID,dfVal$Predictions)
#colnames(dfPreds) = c("ID","Prediction")
#dfPreds

write.csv(dfPreds,file = "LabelPrediction.csv",row.names = FALSE)